(ns util.utils
  (:use clojure.walk
        clojure.tools.logging)
  (:require clojure.string))


(defn evals [form bindings] ; XXX: how about with-local-vars?
  "(prn (evals '(+ x 2) {:x 4}))"
  (if (seq bindings)
    (apply
      (eval
        `(fn [~@(map #(symbol (name %)) (keys bindings))]
          ~form))
      (vals bindings))
    (eval form)))

;;; macros

(defmacro do1 [exp & body]
  `(let [result# ~exp]
    ~@body
    result#))

(defmacro let1 [sym expr & body]
  `(let [~sym ~expr]
     ~@body))

(defmacro or= [x & c]
  (let [xx (gensym)]
    `(let [~xx ~x]
      (or ~@(for [v c] `(= ~xx ~v))))))

(defmacro export ; Please use util.contrib.ns-utils/immigrate
  ([sym]
    (let [x (name (ns-name *ns*))
          y (name (ns-name (:ns (meta (resolve sym)))))
          n (name sym)]
      `(do
        (ns-unmap '~(symbol x) '~sym)
        (def ~(symbol x n) ~(symbol y n)))))
  ([sym1 sym2 & syms]
    `(do
      (export ~sym1)
      (export ~sym2)
      ~@(map (fn [sym] `(export ~sym)) syms))))


(defmacro def- ; version 1
  [name & decls]
    (list* `defn (with-meta name (assoc (meta name) :private true)) decls))

(defmacro def- ; version 2
  [name & decls]
    `(def ~(with-meta name (assoc (meta name) :private true)) ~@decls))

(defmacro set-var! [s v]
  `(alter-var-root (var ~s) (constantly ~v)))

(defmacro with-memoize [vars & body]
  (let [vars (if (sequential? vars) vars [vars])]
    `(binding [~@(apply concat (for [var vars] `(~var (memoize ~var))))]
       ~@body)))

(defmacro with* [withs & body]
  (if (seq withs)
    (if (next withs)
      `(~@(if (sequential? (first withs)) (first withs) [(first withs)])
        (with* ~(next withs) ~@body))
      `(~@(if (sequential? (first withs)) (first withs) [(first withs)])
        ~@body))
    `(do ~@body)))

(defmacro with-if [condition with & body]
  `(if ~condition
    (~@(if (sequential? with) with [with])
      ~@body)
    (do
      ~@body)))

(defn wrap-if [condition f x]
  (if condition
    (f x)
    x))

(defmacro finally1 [& body]
  (when (< (count body) 2)
    (throw (Exception. "Empty finally1 body")))
  `(try
    ~@(butlast body)
    (finally
      ~(last body))))

(defmacro binding* [bindings & body]
  (if (seq bindings)
    `(binding [~@(take 2 bindings)]
      (binding* ~(drop 2 bindings) ~@body))
    `(do ~@body)))

(defmacro exception-log [& body]
  `(try
    ~@body
    (catch Throwable e#
      (error e# (.getMessage e#))
      nil)))

(defmacro exception-log-throw [& body]
  `(try
    ~@body
    (catch Throwable e#
      (error e# e#)
      (throw e#))))

(defmacro exception-print [& body]
  `(try
    ~@body
    (catch Throwable e#
      (.printStackTrace e#)
      nil)))

(defmacro exception-nil [& body]
  `(try
    ~@body
    (catch Throwable e#
      nil)))

(defmacro exception-or [code value]
  `(try
    ~code
    (catch Throwable e#
      ~value)))

(def ^:dynamic *exception-collector* nil)
(defmacro exception-collect [& body]
  `(try
    ~@body
    (catch Throwable e#
      (swap! *exception-collector* conj e#))))
(defmacro exception-batch-throw [& body]
  `(binding [*exception-collector* (atom [])]
    (exception-collect ~@body)
    (when-let [errors# (seq @*exception-collector*)]
      (throw (Exception. (str "Exceptions thrown: " (clojure.string/join ", " errors#)))))))

(defmacro exception-thrown? [& body]
  `(try
    ~@body
    false
    (catch Throwable e#
      e#)))

(defmacro no-exception-thrown? [& body]
  `(not (exception-thrown? ~@body)))

(defmacro exception-cleanup [body cleanup]
  `(try
    ~body
    (catch Throwable e#
      ~cleanup
      (throw e#))))

(defn retry-n [n f o]
  (loop [retried-times 0 e nil]
    (when (>= retried-times n)
      (throw
        (RuntimeException.
          (format "Sorry, I already tried %s times, but still cannot make it pass..." retried-times)
          e)))
    (when (and (not= retried-times 0) o)
      (o))
    (let [pass (try
                 [(f)]
                 (catch Throwable e
                   (warn e (format "[retry] %s fails..." (inc retried-times)))
                   nil))]
      (if pass
        (first pass)
        (recur (inc retried-times) e)))))

(defmacro retry [n & body]
  `(retry-n ~n (fn [] ~@body) nil))

(declare sleep-seconds)
(defmacro wait-retry [time n & body]
  `(retry-n ~n (fn [] ~@body) (fn [] (sleep-seconds ~time))))

(defmacro compile-when [w & body]
  (when (eval w)
    `(do
      ~@body)))

(defmacro compile-if [condition then else]
  (if (eval condition)
    `(do
      ~@then)
    `(do
      ~@else)))

;; TODO: compile-on-win

(defmacro compile-do [& body]
  (eval `(do ~@body))
  nil)


(defn expand [s f body & {order :order}]
  ((case (or order :pre) :pre prewalk :post postwalk) ; XXX: should I use pre-order as default?
    (fn [node]
      (if (and (sequential? node) (= (first node) s))
        (apply f (rest node))
        node))
    body))

(defn require-deps [expr]
  (let [ns (atom #{})]
    (postwalk
      (fn [node]
        (when (and (symbol? node) (namespace node))
          (swap! ns conj (symbol (namespace node))))
        node)
      expr)
    (doseq [n @ns]
      (try
        (require n)
        (catch Throwable e
          (warn e (str "Error when loading namespace " n)))))))

;;; seq

(defn third [s]
  (first (next (next s))))

(defn as-one
  ([s name]
    (when (empty? s)
      (throw (Exception. (format "No %s found" name))))
    (when (next s)
      (throw (Exception. (format "There is more than one %s: %s" name (seq s)))))
    (first s))
  ([s]
    (as-one s "item")))

(defn as-one-or-nil
  ([s name]
    (when (next s)
      (throw (Exception. (format "There is than one %s: %s" name (seq s)))))
    (first s))
  ([s]
    (as-one-or-nil s "item")))

(defn as-seq [s]
  (when-not (nil? s)
    (if (sequential? s)
      s
      (list s))))

(defn iter-seq [s]
  (let [x (atom s)]
    #(let [v (first @x)]
      (swap! x rest)
      v)))

(defn filter1 [pred coll] ; XXX: is filter1 a good name?
  "(first (filter pred coll)) is not fully lazy, use filter1 for full lazy"
  (when (seq coll)
    (let [x (first coll)]
      (if (pred x)
        x
        (recur pred (rest coll))))))

(defn remove1 [pred coll] ; XXX: is remove1 a good name?
  (filter1 (complement pred) coll))

(defn group-by-first [s]
  (reduce (fn [m [k :as v]] (assoc m k (conj (m k []) v))) {} s))

(defn group-by-fun
  ([fun s]
    (group-by-fun fun s {}))
  ([fun s init]
    (reduce (fn [m v] (let [k (fun v)] (assoc m k (conj (m k []) v)))) init s)))

(defn group-pairs [s]
  (reduce (fn [m [k v]] (assoc m k (conj (m k []) v))) {} s))

(defn group2 [s]
  "DEPRECATED
   please use clojure.core/partition instead "
  (take-nth 2 (map vector s (rest s))))

(defn group-n [s n]
  "DEPRECATED
   please use clojure.core/partition instead "
  (map (partial take n) (take-nth n (take-while seq (iterate next s)))))

(defn index-of [v s]
  (second (first (filter #(= v (first %)) (map vector s (range))))))

(defn remove-nil-values-from-map [m]
  (into {}
    (for [[k v] m :when (not (nil? v))]
      [k v])))

;;; resource

(defn get-resource [path] ; XXX: should I throw FileNotFoundException?
  (if (.exists (java.io.File. path))
    (java.io.File. path)
    (when-let [resource (ClassLoader/getSystemResource path)]
      (.getPath (.toURI resource)))))

(defn get-resource-text ; XXX: should I throw FileNotFoundException?
  ([path encoding]
    (when-let [p (get-resource path)]
      (slurp p :encoding encoding)))
  ([path]
    (get-resource-text path "UTF-8")))

;;; functions

(defn apply-static [c f args]
  "(apply-static Integer \"valueOf\" [\"ff\" 16])"
  (clojure.lang.Reflector/invokeStaticMethod c f (to-array args)))

(defn- get-invalids [all valids]
  (apply disj (set all) valids))

(defn- check-invalids [invalids]
  (when (seq invalids)
    (throw (Exception. (str "Invalid options: " (clojure.string/join ", " (seq invalids)))))))

(defn check-invalid-option-list [opts-list valid-keys]
  (check-invalids (get-invalids (take-nth 2 opts-list) valid-keys)))

(defn check-invalid-option-map [opts-map valid-keys]
  (check-invalids (get-invalids (keys opts-map) valid-keys)))

(defn parse-arguments [opts-list & valid-keys]
  (let [opts (apply array-map opts-list)]
    (check-invalid-option-map opts valid-keys)
    opts))

(defn dissoc-argument [opts k]
  (apply concat (dissoc opts k)))

;;; strings

(defn escape-xml [raw]
  (org.apache.commons.lang.StringEscapeUtils/escapeXml raw))

(defn escape-html [raw]
  (org.apache.commons.lang.StringEscapeUtils/escapeHtml raw))

(defn unescape-html [html]
  (org.apache.commons.lang.StringEscapeUtils/unescapeHtml html))


(defn encode-url
  ([url encoding]
    (java.net.URLEncoder/encode url encoding))
  ([url]
    (encode-url url "UTF-8")))

(defn decode-url
  ([url encoding]
    (java.net.URLDecoder/decode url encoding))
  ([url]
    (decode-url url "UTF-8")))

(defn uuid []
  (str (java.util.UUID/randomUUID)))

(defn re [s]
  "Convert a string to regular expression that matches raw content"
  (if (string? s)
    (re-pattern (java.util.regex.Pattern/quote s))
    s))

(defn re-escape-meta [^String s]
  (java.util.regex.Pattern/quote s))

(defn re-escape-replacement-meta [^String s]
  (java.util.regex.Matcher/quoteReplacement s))

(defn re-escape [^String s]
  ; XXX: this is not a correct name. re-escape here only escape the replacement. It doesn't escape meta char like ., ?
  (re-escape-replacement-meta s))

(defn re? [v]
  (instance? java.util.regex.Pattern v))

(defn hex [n]
  (format "0x%x" n))

(defn str-exception [^Exception e]
  (let [sw (java.io.StringWriter.)
        pw (java.io.PrintWriter. sw)]
    (.printStackTrace e pw)
    (.toString sw)))

(defn next-name [prefix s]
  (let [p (re-pattern (str (java.util.regex.Pattern/quote prefix) "(\\d+)"))
        nums (map #(Integer/parseInt %) (filter identity (map #(second (re-matches p %)) s)))
        n+1 (inc (apply max (or (seq nums) [0])))]
    (str prefix n+1)))

;;; time

(defn date< [^java.util.Date d1 ^java.util.Date d2]
  (.before d1 d2))

(defn now []
  (java.util.Date.))

(defn format-date
  ([format date]
    (let [format (java.text.SimpleDateFormat. format)]
      (.format format date)))
  ([format]
    (format-date format (now))))

(defn format-now [format]
  (format-date format (now)))

(defn normalize-date
  ([date]
    (format-date "yyyy-MM-dd" date))
  ([]
    (normalize-date (now))))

(defn normalize-time
  ([date]
    (format-date "HH:mm:ss" date))
  ([]
    (normalize-time (now))))

(defn normalize-datetime
  ([date]
    (format-date "yyyy-MM-dd HH:mm:ss" date))
  ([]
    (normalize-datetime (now))))

(defn iso-datetime
  ([^java.util.Date d]
    (.print (org.joda.time.format.ISODateTimeFormat/dateTime) (org.joda.time.DateTime. (.getTime d))))
  ([]
    (.print (org.joda.time.format.ISODateTimeFormat/dateTime) (org.joda.time.DateTime.))))

(defn time-as-id
  ([date]
    (format-date "yyyy-MM-dd-HH-mm-ss" date))
  ([]
    (time-as-id (now))))

(defn parse-datetime
  ([text format]
    (let [format (java.text.SimpleDateFormat. format)]
      (.parse format text)))
  ([text]
    (parse-datetime text "yyyy-MM-dd HH:mm:ss")))

(defn parse-date [text]
  (parse-datetime text "yyyy-MM-dd"))

(defn parse-time [text]
  (parse-datetime text "HH:mm:ss"))

(defn parse-xsd-datetime [s]
  (.getTime (javax.xml.bind.DatatypeConverter/parseDateTime s)))

(def unit-map-by-second
  (apply array-map
    (mapcat (fn [[ks v]] (interleave ks (repeat v)))
      {["s" "sec" "second" "seconds"] 1
       ["m" "min" "minute" "minutes"] 60
       ["h" "hour" "hours"] (* 60 60)
       ["d" "day" "days"] (* 24 60 60)})))

(def unit-map-by-milliseconds
  (assoc (into {} (for [[k v] unit-map-by-second] [k (* 1000 v)]))
    "ms" 1 "millisecond" 1 "milliseconds" 1))

(defn- parse-unit [^String s unit-map]
  (let [seconds (unit-map (.toLowerCase s))]
    (when-not seconds
      (throw (Exception. (str "Invalid time unit: " s))))
    seconds))

(defn- parse-time-str [^String s unit-map]
  (when-not (re-matches #"(\s*\d+(\.\d+)?\s*[a-zA-Z]+\s*)+" s)
    (throw (Exception. (str "Time is illformed: " s))))
  (apply + (for [[_ n u] (re-seq #"(\d+(?:\.\d+)?)\s*([a-z]+)" (.toLowerCase s))]
             (* (if (re-matches #"\d+" n) (Integer/parseInt n) (Double/parseDouble n)) (parse-unit u unit-map)))))

(defn- parse-time-str? [s unit-map]
  (if (number? s)
    s
    (let [s (name s)]
      (cond
        (re-matches #"\d+" s) (Integer/parseInt s)
        (re-matches #"\d+\.\d+" s) (Double/parseDouble s)
        :else (parse-time-str s unit-map)))))

(defn parse-seconds [s]
  (parse-time-str? s unit-map-by-second))

(defn parse-milliseconds [ms]
  (parse-time-str? ms unit-map-by-milliseconds))

(defn millis []
  (System/currentTimeMillis))

(defn sleep-seconds [seconds]
  (Thread/sleep (* (parse-seconds seconds) 1000)))

(defn sleep-milliseconds [time]
  (Thread/sleep (parse-milliseconds time)))

(defmacro millis-of [& body]
  `(let [start# (millis)
        result# (do ~@body)
        end# (millis)]
    [(- end# start#) result#]))

(defmacro seconds-of [& body]
  `(let [[m# r#] (millis-of ~@body)]
    [(quot m# 1000) r#]))

(defmacro time* [& expr]
  (let [[message expr] (if (string? (first expr)) [(str (first expr) " ") (rest expr)] [nil expr])]
    `(let [start# (. System (nanoTime))
           ret# (do ~@expr)]
      (prn (str ~message "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs"))
      ret#)))

(defmacro dotimes* [& expr]
  (let [[message expr] (if (string? (first expr))
                           [(str (first expr) " ") (rest expr)]
                           ["" expr])
        [[i n] & body] expr]
    `(let [start# (. System (nanoTime))
           n# ~n]
      (dotimes [~i n#]
        ~@body)
      (let [duration# (- (. System (nanoTime)) start#)
            speed# (double (/ (* n# 1000 1000 1000) duration#))
            ms# (double (/ duration# 1000000))]
        (prn (format "%sElapsed time: %.2f msecs (%.2f per second)" ~message ms# speed#))))))

;;; app


(defn exit-hook [^Runnable action]
  (.. Runtime getRuntime (addShutdownHook (Thread. action))))

(defmacro exit-do [& body]
  `(exit-hook (fn [] ~@body)))

(defn shutdown-agents-at-exit []
  (exit-hook shutdown-agents))

;;; repl

(defn dir-ns
  ([ns]
    (keys (ns-interns ns)))
  ([]
    (dir-ns *ns*)))

;;; file & log

(defn native-spit [f ^String content & options]
  (let [lb (System/getProperty "line.separator")
        content (.replaceAll content "\r?\n" lb)]
    (apply spit f content options)))

(defmacro with-log [log & body]
  `(let [log# ~log]
    (if log#
      (let [out# (with-out-str ~@body)]
        (print out#)
        (flush)
        (native-spit log# out# :append true))
      (do ~@body))))


;;; misc

